home *** CD-ROM | disk | FTP | other *** search
/ Dr. Windows 3 / dr win3.zip / dr win3 / VISUALBA / VBTRANS.ZIP / TRANSP.BAS < prev    next >
BASIC Source File  |  1993-08-16  |  10KB  |  246 lines
  1. Type RECT
  2.     left As Integer
  3.     top As Integer
  4.     right As Integer
  5.     bottom As Integer
  6. End Type
  7.  
  8. Type BITMAP '14 bytes
  9.     bmType As Integer
  10.     bmWidth As Integer
  11.     bmHeight As Integer
  12.     bmWidthBytes As Integer
  13.     bmPlanes As String * 1
  14.     bmBitsPixel As String * 1
  15.     bmBits As Long
  16. End Type
  17.  
  18. ' Message structure
  19. Type POINTAPI
  20.     X As Integer
  21.     Y As Integer
  22. End Type
  23.  
  24. Declare Function BitBlt Lib "GDI" (ByVal hDestDC As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal hSrcDC As Integer, ByVal XSrc As Integer, ByVal YSrc As Integer, ByVal dwRop As Long) As Integer
  25. Declare Function CreateBitmap Lib "GDI" (ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal nPlanes As Integer, ByVal nBitCount As Integer, ByVal lpBits As Any) As Integer
  26. Declare Function CreateCompatibleBitmap Lib "GDI" (ByVal hDC As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer) As Integer
  27. Declare Function CreateCompatibleDc Lib "GDI" (ByVal hDC As Integer) As Integer
  28. Declare Function CreatePatternBrush Lib "GDI" (ByVal hBitmap As Integer) As Integer
  29. Declare Function CreateSolidBrush Lib "GDI" (ByVal crColor As Long) As Integer
  30. Declare Function DeleteDc Lib "GDI" (ByVal hDC As Integer) As Integer
  31. Declare Function DeleteObject Lib "GDI" (ByVal hObject As Integer) As Integer
  32. Declare Function DPtoLP Lib "GDI" (ByVal hDC As Integer, lpPoints As POINTAPI, ByVal nCount As Integer) As Integer
  33. Declare Sub DrawFocusRect Lib "User" (ByVal hDC As Integer, lpRect As RECT)
  34. Declare Function FillRect Lib "User" (ByVal hDC As Integer, lpRect As RECT, ByVal hBrush As Integer) As Integer
  35. Declare Sub FreeLibrary Lib "Kernel" (ByVal hLibModule As Integer)
  36. Declare Function GetDC Lib "User" (ByVal hWnd As Integer) As Integer
  37. Declare Function GetDeviceCaps Lib "GDI" (ByVal hDC As Integer, ByVal nIndex As Integer) As Integer
  38. Declare Function GetMapMode Lib "GDI" (ByVal hDC As Integer) As Integer
  39. Declare Function GetPixel Lib "GDI" (ByVal hDC As Integer, ByVal X As Integer, ByVal Y As Integer) As Long
  40. Declare Function APIGetObject Lib "GDI" Alias "GetObject" (ByVal hObject As Integer, ByVal nCount As Integer, lpObject As Any) As Integer
  41. Declare Sub InvertRect Lib "User" (ByVal hDC As Integer, lpRect As RECT)
  42. Declare Function LineTo Lib "GDI" (ByVal hDC As Integer, ByVal X As Integer, ByVal Y As Integer) As Integer
  43. Declare Function LoadBitmap Lib "User" (ByVal hInstance As Integer, ByVal lpBitmapName As Any) As Integer
  44. Declare Function LoadLibrary Lib "Kernel" (ByVal lpLibFileName As String) As Integer
  45. Declare Function MoveTo Lib "GDI" (ByVal hDC As Integer, ByVal X As Integer, ByVal Y As Integer) As Long
  46. Declare Function Rectangle Lib "GDI" (ByVal hDC As Integer, ByVal X1 As Integer, ByVal Y1 As Integer, ByVal X2 As Integer, ByVal Y2 As Integer) As Integer
  47. Declare Function SelectObject Lib "GDI" (ByVal hDC As Integer, ByVal hObject As Integer) As Integer
  48. Declare Function SetBkColor Lib "GDI" (ByVal hDC As Integer, ByVal crColor As Long) As Long
  49. Declare Function SetMapMode Lib "GDI" (ByVal hDC As Integer, ByVal nMapMode As Integer) As Integer
  50. Declare Function SetPixel Lib "GDI" (ByVal hDC As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal crColor As Long) As Long
  51. Declare Function SetStretchBltMode Lib "GDI" (ByVal hDC As Integer, ByVal nStretchMode As Integer) As Integer
  52. Declare Function ScrollDC Lib "User" (ByVal hDC As Integer, ByVal dx As Integer, ByVal dy As Integer, lprcScroll As RECT, lprcClip As RECT, ByVal hRgnUpdate As Integer, lprcUpdate As RECT) As Integer
  53. Declare Function StretchBlt Lib "GDI" (ByVal hDC%, ByVal X%, ByVal Y%, ByVal nWidth%, ByVal nHeight%, ByVal hSrcDC%, ByVal XSrc%, ByVal YSrc%, ByVal nSrcWidth%, ByVal nSrcHeight%, ByVal dwRop&) As Integer
  54.  
  55. Global Const NOTSRCCOPY = &H330008
  56. Global Const NOTSRCERASE = &H1100A6
  57. Global Const SRCAND = &H8800C6
  58. Global Const SRCCOPY = &HCC0020
  59. Global Const SRCERASE = &H440328
  60. Global Const SRCINVERT = &H660046
  61. Global Const SRCPAINT = &HEE0086
  62. Global Const MERGECOPY = &HC000CA
  63. Global Const MERGEPAINT = &HBB0226
  64. Global Const PATCOPY = &HF00021
  65. Global Const PATINVERT = &H5A0049
  66. Global Const PATPAINT = &HFB0A09
  67.  
  68. Global Const BITSPIXEL = 12
  69.  
  70. Sub LoadTransparantBitmap (ByVal hDC As Integer, ByVal hBitmap As Integer, ByVal lColor As Long, ByVal X As Integer, ByVal Y As Integer)
  71.  
  72. Dim bm As BITMAP
  73. Dim hDcBmp As Integer
  74. Dim rSiz As POINTAPI
  75. Dim rOrg As POINTAPI
  76. Dim rLoc As POINTAPI
  77. Dim hOldObj1 As Integer
  78. Dim hOldObj2 As Integer
  79. Dim hOldObj3 As Integer
  80.  
  81. Dim hDcTmp As Integer
  82. Dim hBitmapTmp As Integer
  83. Dim hBitmap1 As Integer
  84. Dim hBmpWrk As Integer
  85. Dim hDC1 As Integer
  86. Dim hDcWrk As Integer
  87.  
  88.     If hBitmap = 0 Then
  89.     LoadTranspBMP = False
  90.     Exit Sub
  91.     End If
  92.  
  93.     iRes% = APIGetObject(hBitmap, Len(bm), bm)
  94.     rSiz.X = bm.bmWidth
  95.     rSiz.Y = bm.bmHeight
  96.     iRes% = DPtoLP(hDC, rSiz, 1)
  97.     rOrg.X = 0
  98.     rOrg.Y = 0
  99.     iRes% = DPtoLP(hDC, rOrg, 1)
  100.     rLoc.X = X
  101.     rLoc.Y = Y
  102.     iRes% = DPtoLP(hDC, rLoc, 1)
  103.  
  104.     hDcTmp = CreateCompatibleDc(hDC)
  105.     hBitmapTmp = CreateCompatibleBitmap(hDC, bm.bmWidth, bm.bmHeight)
  106.     hOldObj1 = SelectObject(hDcTmp, hBitmapTmp)
  107.  
  108.     hDcBmp = CreateCompatibleDc(hDC)
  109.     hOldObj2 = SelectObject(hDcBmp, hBitmap)
  110.  
  111.     iRes% = BitBlt(hDcTmp, 0, 0, bm.bmWidth, bm.bmHeight, hDcBmp, 0, 0, SRCCOPY)
  112.  
  113.     iRes% = SelectObject(hDcBmp, hOldObj2)
  114.     iRes% = DeleteDc(hDcBmp)
  115.     iRes% = SelectObject(hDcTmp, hOldObj1)
  116.     iRes% = DeleteDc(hDcTmp)
  117.  
  118.     hBitmap = hBitmapTmp
  119.  
  120.     hDcBmp = CreateCompatibleDc(hDC)
  121.     iRes% = SetMapMode(hDcBmp, GetMapMode(hDC))
  122.     hOldObj2 = SelectObject(hDcBmp, hBitmap)
  123.  
  124.     If lColor >= 0 And lColor <= 15 Then lColor = QBColor(lColor)
  125.     lRes& = SetBkColor(hDcBmp, lColor)
  126.  
  127.     hBitmap1 = CreateBitmap(bm.bmWidth, bm.bmHeight, 1, 1, ByVal 0&)
  128.     hDC1 = CreateCompatibleDc(hDC)
  129.     hOldObj1 = SelectObject(hDC1, hBitmap1)
  130.     iRes% = BitBlt(hDC1, 0, 0, bm.bmWidth, bm.bmHeight, hDcBmp, 0, 0, SRCCOPY)
  131.  
  132.     iRes% = SelectObject(hDcBmp, hOldObj2)
  133.     iRes% = DeleteDc(hDcBmp)
  134.  
  135.     hDcBmp = CreateCompatibleDc(hDC)
  136.     iRes% = SetMapMode(hDcBmp, GetMapMode(hDC))
  137.     hOldObj2 = SelectObject(hDcBmp, hBitmap)
  138.  
  139.     hDcWrk = CreateCompatibleDc(hDC)
  140.     hBmpWrk = CreateCompatibleBitmap(hDC, bm.bmWidth, bm.bmHeight)
  141.     hOldObj3 = SelectObject(hDcWrk, hBmpWrk)
  142.     iRes% = BitBlt(hDcWrk, 0, 0, rSiz.X, rSiz.Y, hDC, rLoc.X, rLoc.Y, SRCCOPY)
  143.  
  144.     iRes% = BitBlt(hDcWrk, 0, 0, rSiz.X, rSiz.Y, hDC1, rOrg.X, rOrg.Y, MERGEPAINT)
  145.  
  146.     iRes% = BitBlt(hDcBmp, 0, 0, bm.bmWidth, bm.bmHeight, hDC1, 0, 0, SRCPAINT)
  147.  
  148.     iRes% = BitBlt(hDcWrk, 0, 0, rSiz.X, rSiz.Y, hDcBmp, 0, 0, SRCAND)
  149.     iRes% = BitBlt(hDC, rLoc.X, rLoc.Y, rSiz.X, rSiz.Y, hDcWrk, 0, 0, SRCCOPY)
  150.  
  151.     iRes% = SelectObject(hDcWrk, hOldObj3)
  152.     iRes% = DeleteDc(hDcWrk)
  153.     iRes% = SelectObject(hDcBmp, hOldObj1)
  154.     iRes% = DeleteDc(hDC1)
  155.     iRes% = DeleteObject(hBitmap1)
  156.     iRes% = DeleteObject(hBmpWrk)
  157.     
  158.     iRes% = SelectObject(hDcBmp, hOldObj2)
  159.     iRes% = DeleteDc(hDcBmp)
  160.         
  161.     iRes% = DeleteObject(hBitmap)
  162.     
  163. End Sub
  164.  
  165. Function Minimum (X As Integer, Y As Integer)
  166.     If X < Y Then Minimum = X Else Minimum = Y
  167. End Function
  168.  
  169. Sub MoveTransparantBitmap (ByVal hDC As Integer, ByVal hBmpBg As Integer, ByVal iTop As Integer, ByVal iLeft As Integer, ByVal hBitmap As Integer, ByVal lColor As Long, iOldX As Integer, iOldY As Integer, iNewX As Integer, iNewY As Integer)
  170.  
  171. Dim bm As BITMAP
  172. Dim rSiz As POINTAPI
  173. Dim rLoc As POINTAPI
  174. Dim rOrg As POINTAPI
  175. Dim rNew As POINTAPI
  176. Dim iXDelta As Integer
  177. Dim iYDelta As Integer
  178.  
  179.     If hBmpBg <> 0 Then
  180.     iRes% = APIGetObject(hBitmap, Len(bm), bm)
  181.     rSiz.X = bm.bmWidth
  182.     rSiz.Y = bm.bmHeight
  183.     iRes% = DPtoLP(hDC, rSiz, 1)
  184.  
  185.     rLoc.X = iOldX
  186.     rLoc.Y = iOldY
  187.     iRes% = DPtoLP(hDC, rLoc, 1)
  188.  
  189.     rNew.X = iNewX
  190.     rNew.Y = iNewY
  191.     iRes% = DPtoLP(hDC, rNew, 1)
  192.  
  193.     iXDelta = Abs(rNew.X - rLoc.X)
  194.     iYDelta = Abs(rNew.Y - rLoc.Y)
  195.         
  196.     If (iXDelta <= rSiz.X And iYDelta <= rSiz.Y) Then
  197.         Dim hDcMem As Integer
  198.         Dim hNewBitmap As Integer
  199.         Dim X As Integer, Y As Integer
  200.